home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / 3dtt.arc / 3DTT.BAS
BASIC Source File  |  1985-09-11  |  14KB  |  401 lines
  1. 10  '********************************************
  2. 20  '*                                          *
  3. 30  '*           3D TIC-TAC-TOE                 *
  4. 40  '*                                          *
  5. 50  '*       (C) 1982 Reza Beheshti             *
  6. 60  '*                                          *
  7. 70  '*  3504 Pence Ct.                          *
  8. 80  '*  Annandale, VA.  22003                   *
  9. 90  '*  (703) 560-4821                          *
  10. 100 '*                                          *
  11. 110 '********************************************
  12. 120 '
  13. 130 ' System requirments:
  14. 140 '
  15. 150 ' IBM PC 64K MEM. Min.
  16. 160 ' 1 Disk drive
  17. 170 ' Color/Graphic Board
  18. 180 ' 80 Column monitor (RGB Recommanded)
  19. 190 ' Run under "BASICA"
  20. 200 '
  21. 210 ' ------ ENJOY IT -----
  22. 220 '
  23. 230 '
  24. 240 '
  25. 250 '
  26. 260 SCREEN 1,0:KEY OFF
  27. 270 ON ERROR GOTO 3720
  28. 280 CLS:RANDOMIZE 12
  29. 290 DEFINT A-Y:DEFDBL Z:DIM AA(3000),A(514),NAM$(11),LOS(11),WIN(11),SCR(11)
  30. 300 COLOR 0,0:Y=1:N=0:T=0:W=0:X=0:INSTFL=0:DIFFL=0:WELFL=0
  31. 310 IF DIFFL<> 0 THEN 700
  32. 320 DIFFL=1
  33. 330 GOSUB 3700
  34. 340 DRAW "c1bl90bu30r30f3d20g3f3d25g3l30"
  35. 350 DRAW "u5r24e3u21l25u5r25u20l27u3"
  36. 360 DRAW "br60bd30r40u4l40d4"
  37. 370 DRAW "bu4br60nu25d28r30e4u45h4l30"
  38. 380 DRAW "bu4r32f7d47g7l36u61r4"
  39. 390 DRAW "c2bl120bd2e15r25f3d32g3f3d19g9"
  40. 400 DRAW"u24h3e3u20h4l9"
  41. 410 DRAW "br59bd26e15r36d9g10u4l40" '- shade
  42. 420 DRAW "bu29br55e15r34f7d60g11l8e7u49h7l35" ' d shade
  43. 430 PAINT(110,100),2 '3 shade
  44. 440 PAINT(100,110),1 ' 3 itself
  45. 450 PAINT(150,99),1  '- itself
  46. 460 PAINT(150,82),2  ' - shade
  47. 470 PAINT(187,82),1 ' d shade
  48. 480 PAINT(230,70),2  ' d itself
  49. 490 LOCATE 22,12,0:PRINT" TIC - TAC - TOE"
  50. 500 Y1=5:Y2=Y1+32:FL=1:GOSUB 980
  51. 510 GET(65,45)-(250,133),AA
  52. 520 FOR I=1 TO 800:NEXT
  53. 530 GOSUB 3700
  54. 540 PUT (65,45),AA,XOR
  55. 550 XX=65:YY=65
  56. 560 FOR KI=1 TO 3
  57. 570 FOR K=1 TO 3
  58. 580 PUT (XX,YY),AA:XX=XX+15:YY=YY-15:NEXT K
  59. 590 FOR I=1 TO 700:NEXT
  60. 600 XX=XX-15:YY=YY+15
  61. 610 GOSUB 3700
  62. 620 FOR K=1 TO 2
  63. 630 PUT (XX,YY),AA,XOR:XX=XX-15:YY=YY+15:NEXT K
  64. 640 NEXT KI
  65. 650 DIFFL=1
  66. 660 GOSUB 3700
  67. 670 CLS:LOCATE 12,7,0:PRINT"WELCOM TO 3D TIC-TAC-TOE"
  68. 680 LOCATE 24,3,0:PRINT "(C) 1982  Reza Beheshti"
  69. 690 FOR I=1 TO 2500:NEXT I
  70. 700 FOR I=1 TO 514:A(I)=0:NEXT I
  71. 710 GOSUB 1310
  72. 720 SCREEN 1,0,0:CLS
  73. 730 GOSUB 790
  74. 740 REM do human's move
  75. 750 REM see if tie game though
  76. 760 YZ=YZ+1:IF (YZ=9)*(V=1)+(YZ=33)*(V>1) THEN 3260
  77. 770 GOSUB 1660
  78. 780 GOTO 1750
  79. 790 COLOR 1,0
  80. 800 Y1=10:Y2=Y1+32:FL=1
  81. 810 GOSUB 980
  82. 820 Y1=50:Y2=Y1+32:FL=1
  83. 830 GOSUB 980
  84. 840 Y1=90:Y2=Y1+32:FL=1
  85. 850 GOSUB 980
  86. 860 Y1=130:Y2=Y1+32:FL=1
  87. 870 GOSUB 980
  88. 880 LOCATE 1,22,0:PRINT"1   2   3   4"
  89. 890 LOCATE 2,18,0:PRINT"1"
  90. 900 LOCATE 3,16:PRINT"2"
  91. 910 LOCATE 4,14:PRINT"3"
  92. 920 LOCATE 5,12:PRINT"4"
  93. 930 LOCATE 3,37:PRINT"(1)"
  94. 940 LOCATE 8,37:PRINT"(2)"
  95. 950 LOCATE 13,37:PRINT"(3)"
  96. 960 LOCATE 18,37:PRINT"(4)"
  97. 970 RETURN
  98. 980 LINE (160,Y1)-(272,Y1)
  99. 990 LINE -(205,Y2)
  100. 1000 LINE -(95,Y2)
  101. 1010 LINE -(160,Y1)
  102. 1020 IF FL=1 THEN PAINT (161,Y1+1),2,3
  103. 1030 LINE (188,Y1)-(123,Y2),3
  104. 1040 LINE (216,Y1)-(151,Y2),3
  105. 1050 LINE (244,Y1)-(179,Y2),3
  106. 1060 LINE (143,Y1+8)-(255,Y1+8),3
  107. 1070 LINE (126,Y1+16)-(238,Y1+16)
  108. 1080 LINE (110,Y1+24)-(222,Y1+24)
  109. 1090 RETURN
  110. 1100 END
  111. 1110 ' display X or O subroutine
  112. 1120 ULX=160                    'upper left coord. of board
  113. 1130 ULY=(BORD-1)*40+10            '
  114. 1140 ULY=ULY+(ROW-1)*8            'upper left coord. of box
  115. 1150 ULX=ULX+(COL-1)*28-(ROW-1)*16  '
  116. 1160 IF FG=0 GOTO 1220
  117. 1170 IF FG=2 GOTO 1270
  118. 1180 ' print an X
  119. 1190 LINE (ULX,ULY)-(ULX+11,ULY+8),3   ' ul-lr line
  120. 1200 LINE (ULX-16,ULY+8)-(ULX+27,ULY),3 ' ll-ur line
  121. 1210 RETURN
  122. 1220 ' Print an ellipse
  123. 1230 FOR P=1 TO 15
  124. 1240 COLOR  ,0:CIRCLE (ULX+5,ULY+4),8,1,,,.36
  125. 1250 CIRCLE (ULX+5,ULY+4),8,0,,,.36:NEXT P
  126. 1260 RETURN
  127. 1270 ' print the winning marks on screnn
  128. 1280 GOSUB 3700
  129. 1290 COLOR ,1:CIRCLE (ULX+5,ULY+4),8,0,,,.2
  130. 1300 RETURN
  131. 1310 SCREEN 0,0,0:COLOR 0,4,0
  132. 1320 WIDTH 80:CLS
  133. 1330 LOCATE 3,15,0:PRINT"WELCOME TO ":COLOR 1 :LOCATE 3,28
  134. 1340 PRINT"T I C  -  T A C  -  T O E"
  135. 1350 IF INSTFL<>0 THEN 1540
  136. 1360 COLOR 2:INSTFL=1
  137. 1370 PRINT:PRINT TAB(5)"My name is ";:COLOR 1:PRINT"WIZY ";
  138. 1380 COLOR 2:PRINT"and I will be your opponent"
  139. 1390 PRINT:INPUT"What is your name";NA$
  140. 1400 LOCATE 7,5,0:PRINT:PRINT"Do you need instructions ";NA$
  141. 1410 INPUT K$:K$=LEFT$(K$,1)
  142. 1420 IF K$="y" OR K$="n" OR K$="Y" OR K$="N" THEN 1460
  143. 1430 BEEP:PRINT "Please answer with a YES or NO":FOR I=1 TO 950:NEXT
  144. 1440 FOR J=8 TO 10:LOCATE J,1,0:PRINT"                                      ":NEXT J
  145. 1450 GOTO 1400
  146. 1460 IF K$="n" OR K$="N" THEN 1540
  147. 1470 PRINT:PRINT TAB(3)"3-D TIC-TAC-TOE is played on four boards. You must get 4 in"
  148. 1480 PRINT TAB(3)"a row to win. (Horizonal, Vertical, or Diagonally)"
  149. 1490 PRINT TAB(3)"There are 4 rows and 4 columns on each board, you enter your choice of"
  150. 1500 PRINT TAB(3)"box by a three digit number indicating the row, column, and board number"
  151. 1510 PRINT TAB(3)" i.e. [231] is row 2, column 3, on board 1"
  152. 1520 PRINT TAB(3)"You will play the 'X' and I will take 'O' and I let you play first"
  153. 1530 INSTFL=1
  154. 1540 LOCATE 18,3,0:PRINT"There are 2 versions available as follows:"
  155. 1550 PRINT TAB(5)"1) Moderately hard to beat"
  156. 1560 PRINT TAB(5)"2) Hardest to beat"
  157. 1570 LOCATE 21,3,0:PRINT NA$;" Which one would you like";:INPUT V
  158. 1580 IF V>0 AND V<3 THEN 1620
  159. 1590 BEEP:PRINT"Please chose 1 or 2 only":FOR I=1 TO 999:NEXT
  160. 1600 FOR K=21 TO 24:LOCATE K,1:PRINT"                                    ":NEXT
  161. 1610 GOTO 1570
  162. 1620 LOCATE 25,3,0:PRINT"One moment.."
  163. 1630 GOSUB 3360
  164. 1640 V=V+1:LOCATE 25,2,0:PRINT"Hit [ENTER] to start";:BEEP:INPUT XXX
  165. 1650 SCREEN 1,0,0:RETURN
  166. 1660 REM Input query starts here.
  167. 1670 CODE=0:LOCATE 23,3,0:INPUT"Which box [RCB]";BOX$
  168. 1680 GOSUB 1790   ' to subroutine for valid input check
  169. 1690 IF CODE=1 THEN 1670
  170. 1700 GOSUB 1980
  171. 1710 IF A(D)<>0 THEN 3600
  172. 1720 A(D)=1:FG=1:GOSUB 1110
  173. 1730 LOCATE 23,1,0:PRINT" I'm thinking .......       ":FOR I=1 TO 1500:NEXT I
  174. 1740 RETURN
  175. 1750 REM evaluate all moves
  176. 1760 GOSUB 2620
  177. 1770 GOSUB 2090                  ' do computers move
  178. 1780 GOTO 750                    ' to -> see if tie game though
  179. 1790 ' Subroutine to check VALID input from the player.
  180. 1800 LN=LEN(BOX$):IF LN=3 THEN 1840
  181. 1810 BEEP:LOCATE 23,24,0:BEEP:PRINT"Bad Input":FOR I=1 TO 1500:NEXT
  182. 1820 LOCATE 23,15,0:PRINT"                    "
  183. 1830 CODE=1:RETURN
  184. 1840 R$=MID$(BOX$,1,1):ROW=VAL(R$)
  185. 1850 C$=MID$(BOX$,2,1):COL=VAL(C$)
  186. 1860 B$=MID$(BOX$,3,1):BORD=VAL(B$)
  187. 1870 RER$=" ":CER$=" ":BER$=" "
  188. 1880 IF ROW<1 OR ROW>4 THEN RER$=" ROW   "
  189. 1890 IF COL<1 OR COL>4 THEN CER$=" COLUMN"
  190. 1900 IF BORD<1 OR BORD>4 THEN BER$=" BOARD "
  191. 1910 IF RER$=" " AND CER$=" " AND BER$=" " THEN RETURN
  192. 1920 CODE=1
  193. 1930 LOCATE 23,1,0
  194. 1940 BEEP:PRINT"Invalid  "+RER$+CER$+BER$+"    "
  195. 1950 FOR I=1 TO 2000:NEXT:LOCATE 24,1,0
  196. 1960 LOCATE 23,1,0:PRINT"                                 ":RETURN
  197. 1970 ' **** Subroutine to convert to RCB input
  198. 1980 CON1=(BORD-1)*16
  199. 1990 CON2=(COL-1)*4
  200. 2000 D=CON1+CON2+ROW
  201. 2010 RETURN
  202. 2020 ' ******* Subroutine to convert from RCB
  203. 2030 ZUM1=D/16:BORD=INT(ZUM1+.9899999)
  204. 2040 B1=BORD-1:B2=B1*16:B3=D-B2:ZUM1=B3/4:COL=INT(ZUM1+.9899999)
  205. 2050 B5=COL-1:B6=B5*4:ROW=B3-B6
  206. 2060 RETURN
  207. 2070 REM
  208. 2080 REM---main logic subroutines---
  209. 2090 REM make computer move.
  210. 2100 REM
  211. 2110 REM see if we have a must block condition
  212. 2120 IF (YZ<3)*(V>1)+(YZ=1) THEN 2560
  213. 2130 IF Q=0 THEN 2200
  214. 2140 FOR G=0 TO 3
  215. 2150 E=A(65+G+(Q-1)*4)
  216. 2160 REM find empty box to block with
  217. 2170 IF A(E)=0 THEN K=E : G=4
  218. 2180 NEXT G
  219. 2190 GOTO 2590
  220. 2200 REM clear box value array
  221. 2210 FOR I=1 TO 64 : A(450+I)=0:NEXT I
  222. 2220 REM if u=0 then cats game
  223. 2230 U=0
  224. 2240 REM compute value for each box as it appears in the win array
  225. 2250 FOR I=1 TO (-10*(V=1)-76*(V<>1)) STEP (1-3*(V=2))
  226. 2260 B=A(370+I)
  227. 2270 REM if value of win combo is zero then forget it
  228. 2280 IF B=0 THEN U=1:GOTO 2460
  229. 2290 REM get strategy value of this win combo in f
  230. 2300 F=0
  231. 2310 IF (B=1) + (B=5) THEN F=1
  232. 2320 IF B=2 THEN F=4
  233. 2330 IF B=3 THEN STOP
  234. 2340 IF B=10 THEN F=2
  235. 2350 IF F=0 THEN 2460
  236. 2360 U=1
  237. 2370 REM increment each box in win combo by win value
  238. 2380 E=(I-1)*4+65
  239. 2390 FOR G=0 TO 3
  240. 2400 REM get box number in c
  241. 2410 C=A(E+G)
  242. 2420 REM see if this box is used
  243. 2430 IF A(C) <> 0 THEN 2450
  244. 2440 A(450+C)=A(450+C)+F
  245. 2450 NEXT G
  246. 2460 NEXT I
  247. 2470 REM see if cats game
  248. 2480 IF (U=0)*(V<>2) THEN 3260
  249. 2490 REM get best box now
  250. 2500 L=0
  251. 2510 FOR I=1 TO 64
  252. 2520 IF A(450+I)>L THEN L=A(450+I):K=I
  253. 2530 NEXT I
  254. 2540 REM see if any move found. if not do a random move
  255. 2550 IF L>0 THEN 2590
  256. 2560 GOSUB 3660
  257. 2570 IF A(I)=0 THEN K=I:GOTO 2590
  258. 2580 GOTO 2560
  259. 2590 REM do computer move in k
  260. 2600 GOSUB 2970
  261. 2610 RETURN
  262. 2620 REM
  263. 2630 REM evaluate all moves
  264. 2640 REM
  265. 2650 Q=0:R=0
  266. 2660 REM skip first move on version 1
  267. 2670 IF (YZ<3)*(V>1) THEN 2870
  268. 2680 K1LL=0 'if set then we are to get out of do loop
  269. 2690 FOR I=1 TO (V<>1)*-76+(V=1)*-10
  270. 2700 IF K1LL=1 THEN 2840  'human won, we done! if wizy won .                        keep checking to make sure human didn't win first.
  271. 2710 E=(I-1)*4+65
  272. 2720 F=370+I
  273. 2730 C=0
  274. 2740 FOR J=0 TO 3
  275. 2750 C=C+A(A(J+E))
  276. 2760 NEXT J
  277. 2770 REM see if wizy lost
  278. 2780 A(F)=C
  279. 2790 IF C=4 THEN R=I:K1LL=1:GOTO 2840
  280. 2800 REM must block if human has three in a row
  281. 2810 IF C=3 THEN Q=I
  282. 2820 REM see if comy won
  283. 2830 IF C=15 THEN R=I:K1LL=2:GOTO 2840
  284. 2840 NEXT I
  285. 2850 IF K1LL=1 THEN 3230
  286. 2860 IF K1LL=2 THEN 2890
  287. 2870 RETURN
  288. 2880 REM wizy won. find empty box!
  289. 2890 FOR H=0 TO 3
  290. 2900 C=A(65+H+(R-1)*4)
  291. 2910 IF A(C)=0 THEN K=C:H=4
  292. 2920 NEXT H
  293. 2930 REM do wizy move
  294. 2940 GOSUB 2970
  295. 2950 REM wizy won.
  296. 2960 GOTO 3050
  297. 2970 REM
  298. 2980 REM do wizy move specify in k
  299. 2990 REM
  300. 3000 D=K:A(D)=5
  301. 3010 GOSUB 2020
  302. 3020 FG=0:GOSUB 1110
  303. 3030 LOCATE 23,1,0:PRINT"COMPY takes box ";ROW;COL;BORD:FOR I=1 TO 4000:NEXT
  304. 3040 GOSUB 3630:RETURN
  305. 3050 REM
  306. 3060 REM wizy won/lost
  307. 3070 REM
  308. 3080 FG=2:GOSUB 3300    ' subroutine to mark thru winning boxes
  309. 3090 LOCATE 23,1,0:PRINT"HURRAH I WON !!!";:X=X+1:FOR I=1 TO 9000:NEXT
  310. 3100 CLS:LOCATE 4,1,0:PRINT"Wins: ";W;" Losses: ";X;" Ties: ";T
  311. 3110 LOCATE 7,2,0:PRINT"Do you want to play again ";NA$
  312. 3120 INPUT AN$:AN$=LEFT$(AN$,1)
  313. 3130 IF AN$="y" OR AN$="Y" THEN 310
  314. 3140 IF AN$="n" OR AN$="N" THEN 3180
  315. 3150 BEEP:LOCATE 10,3,0:PRINT"Yes/No please":FOR I=1 TO 1500:NEXT
  316. 3160 LOCATE 10,3,0:PRINT"               "
  317. 3170 GOTO 3110
  318. 3180 CLS:LOCATE 9,1,0:PRINT"I liked playing with you..."
  319. 3190 PRINT:PRINT"See you soon!"
  320. 3200 LOCATE 23,1,0
  321. 3210 CLS:RUN "MENU.PGM"
  322. 3220 REM wizy lost
  323. 3230 FG=2:GOSUB 3300  ' *********  mark the winning boxes
  324. 3240 LOCATE 23,1,0:PRINT"BOO-HOO I LOST .....":W=W+1:FOR I=1 TO 9000:NEXT I
  325. 3250 GOTO 3100
  326. 3260 LOCATE 23,1,0:PRINT"Tie game ...":FOR I=1 TO 9000:NEXT I
  327. 3270 GOSUB 3630
  328. 3280 GOTO 3100
  329. 3290 REM
  330. 3300 REM mark thru wins
  331. 3310 REM
  332. 3320 FOR H=0 TO 3:D=A(65+H+(R-1)*4)
  333. 3330 GOSUB 2020  ' convert d to rcb
  334. 3340 F=2:GOSUB 1110  ' mark thru wins
  335. 3350 NEXT H:RETURN
  336. 3360 REM
  337. 3370 REM setup win array
  338. 3380 REM
  339. 3390 RESTORE
  340. 3400 FOR I=1 TO 10:FOR C=0 TO 3:READ A(65+C+(I-1)*4):NEXT C:NEXT I
  341. 3410 FOR I=57 TO 76:FOR C=0 TO 3
  342. 3420 READ A(65+C+(I-1)*4)
  343. 3430 NEXT C:NEXT I
  344. 3440 FOR I=1 TO 3:FOR C=1 TO 10:FOR E=0 TO 3
  345. 3450 A(E+65+(C+I*10-1)*4)=A(E+65+(C-1)*4)+16*I
  346. 3460 NEXT E:NEXT C:NEXT I
  347. 3470 FOR I=41 TO 56:FOR C=0 TO 3
  348. 3480 A(65+C+(I-1)*4)=C*16+I-40:NEXT C:NEXT I
  349. 3490 RETURN
  350. 3500 DATA 1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,1,5,9,13,2
  351. 3510 DATA 6,10,14
  352. 3520 DATA 3,7,11,15,4,8,12,16,1,6,11,16,4,7,10,13,1,22,43,64
  353. 3530 DATA 5,22,39,56,9,26,43,60,13,26,39,52,2,22,42,62,14,26
  354. 3540 DATA 38,50
  355. 3550 DATA 3,23,43,63,15,27,39,51,4,23,42,61,8,23,38,53,12,27
  356. 3560 DATA 42,57,16,27,38,49
  357. 3570 DATA 1,21,41,61,1,18,35,52,4,19,34,49,4,24,44,64
  358. 3580 DATA 13,25,37,49,13,30,47,64,16,31,46,61,16,28,40,52
  359. 3590 REM
  360. 3600 LOCATE 23,1,0:BEEP:PRINT"Box already taken!":FOR I=1 TO 1500:NEXT I
  361. 3610 GOSUB 3630
  362. 3620 GOTO 1670
  363. 3630 ' subroutine to clean up line 23 on screen
  364. 3640 LOCATE 23,1,0:PRINT"                              "
  365. 3650 RETURN
  366. 3660 Z1=(RND*100)
  367. 3670 I=INT(Z1):IF I<1 OR I>64 THEN 3660
  368. 3680 RETURN
  369. 3690 REM Subroutine to play the music
  370. 3700 PLAY "MBL12T128O3CDEFGABFEDCBADO4C"
  371. 3710 RETURN
  372. 3720 REM error handling routine
  373. 3730 CLS
  374. 3740 IF ERR=53 THEN 3830
  375. 3750 IF ERR=61 THEN 3860
  376. 3760 IF ERR=70 THEN 3910
  377. 3770 IF ERR=71 THEN 3940
  378. 3780 IF ERR=73 THEN 3970
  379. 3790 XX=ERR
  380. 3800 PRINT:PRINT"UNEXPECTED error number [";XX;"]"
  381. 3810 PRINT:PRINT"Please look it up in your basic manual"
  382. 3820 PRINT" in Appendix A.":END
  383. 3830 PRINT" Seems like you have the wrong disk in drive 'A`"
  384. 3840 PRINT "Please double check it."
  385. 3850 GOTO 3990
  386. 3860 PRINT"Opps... Your disk space is full, please make "
  387. 3870 PRINT" sure you have the right diskette in drive 'A`"
  388. 3880 PRINT" or you have to erase some data from the diskette"
  389. 3890 PRINT" in drive 'A` before you could save any more data on it."
  390. 3900 GOTO 3990
  391. 3910 PRINT" Diskette write protection notch is covered and I can "
  392. 3920 PRINT"not record your score unless you remove it."
  393. 3930 GOTO 3990
  394. 3940 PRINT" Drive 'A` is not ready, please insert the right "
  395. 3950 PRINT "diskette in, or make sure the drive door is closed."
  396. 3960 GOTO 3990
  397. 3970 PRINT" Advanced BASIC is required. Please load BASICA and rerun"
  398. 3980 END
  399. 3990 PRINT:PRINT
  400. 4000 end
  401.